home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Construc / XMLSTR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  2000-10-04  |  3.5 KB  |  117 lines
  1. unit XMLStr;
  2. interface
  3. uses
  4.   DB;
  5.  
  6. function DataSetXMLString(DataSet: TDataSet): String;
  7.  
  8. implementation
  9. uses
  10.   SysUtils, TypInfo;
  11.  
  12. function DataSetXMLString(DataSet: TDataSet): String;
  13. var
  14.   Str: String;
  15.   i: Integer;
  16.  
  17.   function Print(Str: String): String;
  18.   { Convert a fieldname to a printable name }
  19.   var
  20.     i: Integer;
  21.   begin
  22.     for i:=Length(Str) downto 1 do
  23.       if not (UpCase(Str[i]) in ['A'..'Z','1'..'9']) then
  24.         Str[i] := '_';
  25.     Result := Str
  26.   end {Print};
  27.  
  28.   function EnCode(Str: String): String;
  29.   { Convert memo contents to single line XML }
  30.   var
  31.     i: Integer;
  32.   begin
  33.     for i:=Length(Str) downto 1 do
  34.     begin
  35.       if (Ord(Str[i]) in [1..31]) or (Str[i] = '"') then
  36.       begin
  37.         Insert('&#'+IntToStr(Ord(Str[i]))+';',Str,i+1);
  38.         Delete(Str,i,1)
  39.       end
  40.       else
  41.         if Str[i] = #0 then Delete(Str,i,1)
  42.     end;
  43.     Result := Str
  44.   end {EnCode};
  45.  
  46. begin
  47.   ShortDateFormat := 'YYYYMMDD';
  48.   try
  49.     Str := '<?xml version="1.0" standalone="yes"?>';
  50.     Str := Str + '<DATAPACKET Version="2.0">';
  51.     with DataSet do
  52.     begin
  53.       Str := Str + '<METADATA>';
  54.       Str := Str + '<FIELDS>';
  55.       if not Active then
  56.         FieldDefs.Update { get info without opening the database };
  57.       for i:=0 to Pred(FieldDefs.Count) do
  58.       begin
  59.         Str := Str + '<FIELD ';
  60.         if Print(FieldDefs[i].Name) <> FieldDefs[i].Name then { fieldname }
  61.           Str := Str + 'fieldname="' + FieldDefs[i].Name + '" ';
  62.         Str := Str + 'attrname="' + Print(FieldDefs[i].Name) + '" fieldtype="';
  63.         case FieldDefs[i].DataType of
  64.           ftString,
  65.        ftFixedChar,
  66.       ftWideString: Str := Str + 'string';
  67.          ftBoolean: Str := Str + 'boolean';
  68.         ftSmallint: Str := Str + 'i2';
  69.          ftInteger: Str := Str + 'i4';
  70.          ftAutoInc: Str := Str + 'i4" readonly="true" SUBTYPE="Autoinc';
  71.             ftWord, // why not i4 ??
  72.            ftFloat: Str := Str + 'r8';
  73.         ftCurrency: Str := Str + 'r8" SUBTYPE="Money';
  74.              ftBCD: Str := Str + 'fixed';
  75.             ftDate: Str := Str + 'date';
  76.             ftTime: Str := Str + 'time';
  77.         ftDateTime: Str := Str + 'datetime';
  78.            ftBytes: Str := Str + 'bin.hex';
  79.         ftVarBytes,
  80.             ftBlob: Str := Str + 'bin.hex" SUBTYPE="Binary';
  81.             ftMemo: Str := Str + 'bin.hex" SUBTYPE="Text';
  82.          ftGraphic,
  83.      ftTypedBinary: Str := Str + 'bin.hex" SUBTYPE="Graphics';
  84.          ftFmtMemo: Str := Str + 'bin.hex" SUBTYPE="Formatted';
  85.       ftParadoxOle,
  86.         ftDBaseOle: Str := Str + 'bin.hex" SUBTYPE="Ole'
  87.         end;
  88.         if FieldDefs[i].Required then Str := Str + '" required="true';
  89.         if FieldDefs[i].Size > 0 then Str := Str + '" WIDTH="' + IntToStr(FieldDefs[i].Size);
  90.         Str := Str + '"/>'
  91.       end;
  92.       Str := Str + '</FIELDS>';
  93.       Str := Str + '</METADATA>';
  94.       if not Active then Open;
  95.       Str := Str + '<ROWDATA>';
  96.       while not Eof do
  97.       begin
  98.         Str := Str + '<ROW ';
  99.         for i:=0 to Pred(Fields.Count) do
  100.           if (Fields[i].AsString <> '') and
  101.             ((Fields[i].DisplayText = Fields[i].AsString) or
  102.              (Fields[i].DisplayText = '(MEMO)')) then
  103.             Str := Str + Print(Fields[i].FieldName) + '="' +
  104.                          EnCode(Fields[i].AsString) + '" ';
  105.         Str := Str + '/>';
  106.         Next
  107.       end;
  108.       Str := Str + '</ROWDATA>'
  109.     end;
  110.     Str := Str + '</DATAPACKET>'
  111.   finally
  112.     Result := Str
  113.   end
  114. end;
  115.  
  116. end.
  117.